home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / PRECIRES.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  6.2 KB  |  235 lines
  1. 10  'PRECIRES - Precision Resistor - 07 SEP 94 rev. 27 DEC 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
  4. 40  COMMON PROG$,EX$
  5. 50  CLS:KEY OFF
  6. 60  COLOR 7,0,1
  7. 70  DIM R(25)            'resistors
  8. 80  UL$=STRING$(80,205)  'underline
  9. 90  ER$=STRING$(80,32)   'erase
  10. 100  U1$="########,##.#"
  11. 110  U2$="#########.###"
  12. 120  U3$="#########.##"+" "
  13. 130  U4$="#######,###"+"  "
  14. 140  U5$="####.#"
  15. 150  O$=" -"
  16. 160  VIEW PRINT 3 TO 23:CLS:VIEW PRINT
  17. 170  DATA 10,11,12,13,15,16,18,20,22,24,27,30,33,36,39
  18. 180  DATA 43,47,51,56,62,68,75,82,91,100
  19. 190  FOR Z=0 TO 24:READ R(Z):NEXT Z
  20. 200  '
  21. 210  '.....start
  22. 220  CLS
  23. 230  COLOR 15,2
  24. 240  PRINT " PRECISION RESISTOR";TAB(57);"by George Murphy VE3ERP ";
  25. 250  COLOR 1,0:PRINT STRING$(80,"<0xDF!>");
  26. 260  COLOR 7,0
  27. 270  '
  28. 280  '.....diagram
  29. 290  T=24       'tab
  30. 300  COLOR 0,7
  31. 310  LOCATE  3,T:PRINT "                                   "
  32. 320  LOCATE  4,T:PRINT "  CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND R SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL  "
  33. 330  LOCATE  5,T:PRINT "  CALL                             CALL  "
  34. 340  LOCATE  6,T:PRINT "  CALL    VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUND/\/\/\/SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR    CALL  "
  35. 350  LOCATE  7,T:PRINT "       CALL        Ra         CALL       "
  36. 360  LOCATE  8,T:PRINT " X SOUNDSOUNDSOUNDSOUND<0xB4!>                   BLOADSOUNDSOUNDSOUNDSOUND Y "
  37. 370  LOCATE  9,T:PRINT "       CALL                   CALL       "
  38. 380  LOCATE 10,T:PRINT "       CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUND/\/\/\/SOUNDSOUNDSOUNDSOUNDSOUNDSOUND'       "
  39. 390  LOCATE 11,T:PRINT "                Rb                 "
  40. 400  COLOR 7,0
  41. 410  LOCATE 12:PRINT UL$;
  42. 420  IF R THEN 660
  43. 430  '
  44. 440  M=7
  45. 450  PRINT TAB(M);
  46. 460  PRINT "This program calculates the values of two standard value resistors"
  47. 470  PRINT TAB(M);
  48. 480  PRINT "Ra and Rb which, when connected in parallel, will result in a net"
  49. 490  PRINT TAB(M);
  50. 500  PRINT "resistance R that will be within very close tolerances of almost any"
  51. 510  PRINT TAB(M);
  52. 520  PRINT "value you want."
  53. 530  PRINT UL$;
  54. 540  '
  55. 550  '.....inputs
  56. 560  COLOR 0,7:LOCATE CSRLIN,22
  57. 570  PRINT " Press 1 to continue or 0 to EXIT.....":COLOR 7,0
  58. 580  Z$=INKEY$:IF Z$=""THEN 580
  59. 590  IF Z$="0"THEN CLS:CHAIN GO$
  60. 600  IF Z$="1"THEN 630
  61. 610  GOTO 580
  62. 620  '
  63. 630  VIEW PRINT 13 TO 24:CLS:VIEW PRINT:LOCATE 13
  64. 640  PRINT " ENTER:";
  65. 650  '
  66. 660  LOCATE CSRLIN,8
  67. 670  COLOR 14,4
  68. 680  PRINT " Sought precise resistance R between X & Y ......(ohms)=";
  69. 690  COLOR 7,0
  70. 700  IF R THEN PRINT:GOTO 730 ELSE INPUT R  'if R chained from another program
  71. 710  IF R=0 THEN LOCATE CSRLIN-1:PRINT ER$;:LOCATE CSRLIN-1:GOTO 550
  72. 720  IF R<10 THEN 970
  73. 730  LOCATE CSRLIN-1:PRINT STRING$(7,32)
  74. 740  LOCATE CSRLIN-1,55:COLOR 14,4:PRINT "......R ="
  75. 750  LOCATE CSRLIN-1,64:PRINT USING U1$;R;:PRINT O$:COLOR 7,0
  76. 760  '
  77. 770  '.....find next larger standard resistor
  78. 780  M=0.1                   'multiplier
  79. 790  '
  80. 800  FOR Z=1 TO 24
  81. 810   RA=R(Z)*M             'Ra= standard resistor
  82. 820   IF RA=R THEN 880
  83. 830   IF RA>=R THEN 1060     'exit for/next loop
  84. 840  NEXT Z
  85. 850  M=M*10
  86. 860  GOTO 800               'run loop again
  87. 870  '
  88. 880  '.....standard resistor entered
  89. 890  BEEP:PRINT
  90. 900  COLOR 0,7
  91. 910  LOCATE CSRLIN,17:PRINT " ...... This is a standard resistor value ...... "
  92. 920  LOCATE CSRLIN,17:PRINT " ............ Press any key to exit ............ "
  93. 930  COLOR 7,0
  94. 940  IF INKEY$=""THEN 940
  95. 950  GOTO 2150   'end
  96. 960  '
  97. 970  '.....resistor <10 ohms entered
  98. 980  BEEP:PRINT :COLOR 0,7
  99. 990  PRINT" For precision resistors less than 10 - refer to the HAMCALC program "
  100. 1000  PRINT" COPPER WIRE PROGRAMS for data on copper wire resistors.             "
  101. 1010  PRINT" ..................Press any key to start over......................."
  102. 1020  COLOR 7,0
  103. 1030  IF INKEY$=""THEN 940
  104. 1040  GOTO 210   'start
  105. 1050  '
  106. 1060  PRINT "        Value of next standard resistor greater than R.....Ra =";
  107. 1070  PRINT USING U4$;RA;:PRINT O$
  108. 1080  '
  109. 1090  RX=R*RA/(RA-R)         'parallel resistor
  110. 1100  '
  111. 1110  '.....find nearest standard resistor
  112. 1120  M=1                    'multiplier
  113. 1130  '
  114. 1140  FOR Z=1 TO 24
  115. 1150   RH=R(Z)*M             'RS= next higher standard resistor
  116. 1160   IF RH>=RX THEN 1210
  117. 1170  NEXT Z
  118. 1180  M=M*10
  119. 1190  GOTO 1140               'run loop again
  120. 1200  '
  121. 1210  RL=R(Z-1)*M            'next lower standard resistor
  122. 1220  RM=(RL+RH)/2           'median value
  123. 1230  IF RX<RM THEN RB=RL
  124. 1240  IF RX>=RM THEN RB=RH
  125. 1250  '
  126. 1260  '.....display results
  127. 1270  PRINT "        Value of parallel resistor to obtain R precisely..... =";
  128. 1280  PRINT USING U1$;RX;:PRINT O$
  129. 1290  '
  130. 1300  PRINT "        Value of closest standard resistor.................Rb =";
  131. 1310  PRINT USING U4$;RB;:PRINT O$
  132. 1320  '
  133. 1330  RC=1/(1/RA+1/RB)
  134. 1340  PRINT "       ";
  135. 1350  COLOR 15,0
  136. 1360  PRINT " RESISTANCE OF Ra & Rb IN PARALLEL BETWEEN X & Y....Rc =";
  137. 1370  PRINT USING U1$;RC;:PRINT O$
  138. 1380  COLOR 7,0
  139. 1390  '
  140. 1400  D=ABS(R-RC)/R*100
  141. 1410  COLOR 14,4:LOCATE CSRLIN,8
  142. 1420  PRINT " DIVERGENCE of Rc from R.............................. =";
  143. 1430  PRINT USING U2$;D;:PRINT " %"
  144. 1440  COLOR 7,0
  145. 1450  '
  146. 1460  IF E=-1 THEN 1800                'if E chained from another program
  147. 1470  IF E<>0 THEN PRINT :GOTO 1590    'if E chained from another program
  148. 1480  COLOR 15,1:LOCATE CSRLIN,8
  149. 1490  PRINT " Do you want to calculate current through Ra & Rb ?  (y/n) ";
  150. 1500  COLOR 7,0
  151. 1510  Z$=INKEY$
  152. 1520  IF Z$="n"OR Z$="N"THEN 1560
  153. 1530  IF Z$="y"OR Z$="Y"THEN 1590
  154. 1540  GOTO 1510
  155. 1550  '
  156. 1560  LOCATE CSRLIN-1:PRINT ER$;:LOCATE CSRLIN-1:PRINT UL$;:GOSUB 1880
  157. 1570  GOTO 2150   'end
  158. 1580  '
  159. 1590  '.....calculate current
  160. 1600  LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1
  161. 1610  PRINT " ENTER: Voltage drop between X & Y..........................E =";
  162. 1620  IF E THEN PRINT :GOTO 1630 ELSE INPUT E
  163. 1630  LOCATE CSRLIN-1:PRINT STRING$(7,32)
  164. 1640  LOCATE CSRLIN-1,64:PRINT USING U2$;E;:PRINT " v."
  165. 1650  '
  166. 1660  I=E/RA:GOSUB 1830
  167. 1670  PRINT "        Current through Ra @............................I(Ra) =";
  168. 1680  PRINT USING U2$;II;:PRINT V$
  169. 1690  P=I*E:LOCATE CSRLIN-1,29:PRINT USING"#####.###";P;:PRINT " watts"
  170. 1700  '
  171. 1710  I=E/RB:GOSUB 1830
  172. 1720  PRINT "        Current through Rb @............................I(Rb) =";
  173. 1730  PRINT USING U2$;II;:PRINT V$
  174. 1740  P=I*E:LOCATE CSRLIN-1,29:PRINT USING"#####.###";P;:PRINT " watts"
  175. 1750  '
  176. 1760  I=E/RC:GOSUB 1830
  177. 1770  PRINT "        Total current between X and Y...................I(Rc) =";
  178. 1780  PRINT USING U3$;II;:PRINT V$
  179. 1790  '
  180. 1800  PRINT UL$;:GOSUB 1880
  181. 1810  GOTO 2150   'end
  182. 1820  '
  183. 1830  '.....unit of current
  184. 1840  IF I>=1 THEN II=I:V$=" A."
  185. 1850  IF I<1 THEN II=I*10^3:V$=" mA"
  186. 1860  RETURN
  187. 1870  '
  188. 1880  '.....add to diagram
  189. 1890  '
  190. 1900  N=1
  191. 1910  IF 10^N<=R THEN N=N+1:GOTO 1910
  192. 1920  COLOR 7,0
  193. 1930  X1=RA:X1$=" -"
  194. 1940  IF RA>10^3 THEN X1=RA/10^3:X1$=" K-"
  195. 1950  IF RA>10^6 THEN X1=RA/10^6:X1$=" meg-"
  196. 1960  '
  197. 1970  X2=RB:X2$=" -"
  198. 1980  IF RB>10^3 THEN X2=RB/10^3:X2$=" K-"
  199. 1990  IF RB>10^6 THEN X2=RB/10^6:X2$=" meg-"
  200. 2000  '
  201. 2010  X3=RC:X3$="-"
  202. 2020  IF RC>10^3 THEN X3=RC/10^3:X3$="K-"
  203. 2030  IF RC>10^6 THEN X3=RC/10^6:X3$="meg-"
  204. 2040  X3=INT(X3*10^3+0.5)/10^3
  205. 2050  N=1
  206. 2060  IF 10^N<X3 THEN N=N+1:GOTO 2060
  207. 2070  UX$=STRING$(N,"#")+".###"
  208. 2080  '
  209. 2090  COLOR 14,4
  210. 2100  LOCATE 4,T+10:PRINT " Rc= ";USING UX$;X3;:PRINT " ";X3$
  211. 2110  LOCATE 7,T+10:PRINT " Ra=";USING U5$;X1;:PRINT X1$
  212. 2120  LOCATE 11,T+10:PRINT " Rb=";USING U5$;X2;:PRINT X2$
  213. 2130  COLOR 7,0
  214. 2140  '
  215. 2150  '.....end
  216. 2160  GOSUB 2220
  217. 2170  IF EX$<>GO$ THEN CLS:CHAIN GO$
  218. 2180  E=0:R=0:RA=0:RB=0:RC=0:RH=0:RX=0
  219. 2190  GOTO 210
  220. 2200  END
  221. 2210  '
  222. 2220  'HARDCOPY
  223. 2230  GOSUB 2340:LOCATE 25,2:COLOR 14,6
  224. 2240  PRINT " Press 1 to print screen, 2 to print screen & ";
  225. 2250  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  226. 2260  Z$=INKEY$:IF Z$="3"THEN GOSUB 2340:RETURN
  227. 2270  IF Z$="1"OR Z$="2"THEN GOSUB 2340:GOTO 2290
  228. 2280  GOTO 2260
  229. 2290  FOR QX=1 TO 24:FOR QY=1 TO 80
  230. 2300  LPRINT CHR$(SCREEN(QX,QY));
  231. 2310  NEXT QY:NEXT QX
  232. 2320  IF Z$="2"THEN LPRINT CHR$(12)
  233. 2330  GOTO 2230
  234. 2340  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  235.